Loading Packages & Initialization

reference : https://gist.github.com/mertedali/ab7078b9c29dea18c72525239d636b96

rm(list=ls())

library(data.table)
library(tidyverse)
library(rJava)
library(RNetLogo)

library(lhs) # For maximin Latin hypercube sampling
library(ggplot2)
library(plotly) # For beautiful plotting
library(caret)
library(randomForest)
library(factoextra)
library(e1071)
library(TSrepr) # for evaluating predictive power

require(gridExtra)

options(warn = -1)

# Select if data generation is wanted
GenerateTTData <- 0

Is_Headless <- 1
nl.model <- "Segregation"

nl.path <- "C:/Program Files/NetLogo 6.0.4/app"
model.path <- paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/",nl.model,".nlogo")

if (Is_Headless == 0){
    NLStart(nl.path, gui = TRUE,nl.jarname='netlogo-6.0.4.jar')
    NLLoadModel (model.path)
    } else {
    NLStart(nl.path, gui = FALSE,nl.jarname='netlogo-6.0.4.jar', nl.obj = nl.model)
    NLLoadModel (model.path, nl.obj = nl.model)
    
    #NLStart(nl.path, gui = FALSE,nl.jarname='netlogo-6.0.4.jar', nl.obj = nl.model)
    #NLLoadModel (model.path, nl.obj = nl.model )
    }

Model Parameters & Functions

Set model parameters

set.seed(1)

## Set model parameters
 # Number of replications for each instance
nofrep = 10   

# Number of iterations
iteration_budget = 20
 # order feature names according to their definition order in run_model
feature_names = c("density","%-similar-wanted")  
 # 
output_name = c("percent-similar")

 # Number of input parameters of the agent-based model
nofparams = length(feature_names)      

# set RF parameters
ntree = 400
mtry = 2

Set user parameters

error_type = "RMSE" # MAPE, BIAS

# choose the uncertainty measure
selection_metric <- "sd" #, "range" 

unlabeled_ins = 700 
test_ins = 400
train_ins_oneshot = 700
train_ins_Ad = 200

# Set selection parameters
selected_ins = 5 #nofinstancesWillbeSelected in each step

# Set elimination parameters
h <- 1 # number of variables eliminated in each step

Define functions

run_model

#run_model <- function(feature_names,feature_values){ # both should be in character list format
run_model <- function(feature_values){ # both should be in character list format

    
    k = length(feature_names)    
    for(i in 1:k){
        NLCommand(paste0("set ",feature_names[i]," ",feature_values[i]), nl.obj = nl.model)      
    }
    NLCommand("setup", nl.obj = nl.model)
    NLDoCommand(100, "go", nl.obj = nl.model) 
    result <- NLReport(output_name, nl.obj = nl.model)
    return(result)   
}

run_replicas

#run_replicas <- function(nofrep,feature_names,feature_values) {
run_replicas <- function(nofrep,feature_values) {
    replicas = matrix(NA, ncol = nofrep, nrow = 1) # Save the result of each replication
    for(i in 1:nofrep){
     #   replicas[i]= run_model(feature_names,feature_values)
        replicas[i]= run_model(feature_values)
    }
    aggregated_result = mean(replicas)
    return(aggregated_result)
}

run_ABM

#run_ABM = function(nofrep,nofinstances,unlabeledset,featurenames = feature_names){
run_ABM = function(nofrep,nofinstances,unlabeledset){
   #unlabeledset = setcolorder(unlabeledset,featurenames) 
   unlabeledset = setcolorder(unlabeledset,feature_names) 
   for(i in 1:nofinstances){
        #unlabeledset[i, output :=  run_replicas(nofrep,featurenames, as.matrix(unlabeledset[i,]))]    
        unlabeledset[i, output :=  run_replicas(nofrep, as.matrix(unlabeledset[i,]))] 
    } 
    return(unlabeledset)
}

error functions

#error functions on test data
rmse_func <- function(actual, predicted){
    error = predicted - actual
    return(sqrt(mean(error^2)))
}

mape_func <- function(actual,predicted){
    return( (abs(actual - predicted)/ actual)*100 )
}

bias_func <- function(actual,predicted){
    return( (actual - predicted)/ actual )
}

#error functions on train data
obb_error_func <- function(model){
   if(model$type == "regression"){
        oob_error = model$mse[model$ntree] 
    }else if(model$type == "classification"){
        oob_error = model$err.rate 
    } 
    return(oob_error)
}

get_test_predictions

# prediction functions
get_test_predictions <- function(model,testset,errortype){
    
    predictedLabels <- predict(model, testset)
    predictedLabels <- cbind(testset,predictedLabels)
    setnames(predictedLabels, "predictedLabels","pred_output")

    output_variables = colnames(select(predictedLabels, contains("output")))
    # output_variables[1] = true output
    # output_variables[2] = predicted output
    
    #output_variables = colnames(predictedLabels[,1:(ncol(predictedLabels) - 2)])
    
    if(error_type == "MAPE"){
        predictedLabels[,MAPE := mapply(function(x,y) mape_func(x,y),get(output_variables[1]),get(output_variables[2]))]
          }
    if(error_type == "RMSE"){
        predictedLabels[,RMSE := mapply(function(x,y) rmse_func(x,y),get(output_variables[1]),get(output_variables[2]))]
          }
    if(error_type == "BIAS"){
        predictedLabels[,BIAS := mapply(function(x,y) bias_func(x,y),get(output_variables[1]),get(output_variables[2]))]
           } 
                                  
     output_variables_1 = predictedLabels[,get(output_variables[1]), with = TRUE]
     output_variables_2 = predictedLabels[,get(output_variables[2]), with = TRUE]
    
     performance_temp = matrix(c(1:3), nrow = 1, ncol = 3)
     performance_temp[1] =  mae(output_variables_1 , output_variables_2)
     performance_temp[2] = rmse(output_variables_1 , output_variables_2)
     performance_temp[3] = mape(output_variables_1 , output_variables_2)
    
    return(list(predictedLabels,performance_temp,output_variables))
    
}

sample_selection

# Adaptive sample selection function with an uncertainty measure depending on "selection_metric"
sample_selection <- function(selected_ins,unlabeled_set,model){   
    ind_pred <- t(predict(model, unlabeled_set,predict.all = TRUE)$individual) %>% 
                data.table() # predictions by each tree in the forest
    ind_pred_eval = data.table()
    
    # standard deviation calculation
    s_dev = sapply(ind_pred, sd) %>% data.table()
    setnames(s_dev,".","sd")
    ind_pred_eval = cbind(ind_pred_eval,s_dev)
    
    # range calculation
    range = sapply(ind_pred, range) %>% t() %>% data.table()
    range = range[,.(range = abs(range[,1] - range[,2]))]
    setnames(range,"range.V1","range")
    ind_pred_eval = cbind(ind_pred_eval,range)
    
    ind_pred_eval[,idx := 1:.N]
    
    if(selection_metric == "sd") {
      ind_pred_eval = ind_pred_eval[order(-sd)][1:selected_ins]
    }else if(selection_metric == "range"){
      ind_pred_eval = ind_pred_eval[order(-range)][1:selected_ins]
    }
    
    unlabeled_set[,idx := 1:.N]    
    train_candidates = unlabeled_set[ind_pred_eval$idx]
    
    return(train_candidates)
}

random_sample_selection

# Random sample selection
random_sample_selection <- function(selected_ins,unlabeled_set){
  
    unlabeled_set[,idx := 1:.N]
    
    train_candidate_idx = sample(unlabeled_set$idx, selected_ins, replace = FALSE, prob = NULL)   
    train_candidates = unlabeled_set[idx %in% train_candidate_idx]
    
    return(train_candidates)
}

get_variable_importance

get_variable_importance <- function(model){
    importances <- importance(model, type = 1, scale = FALSE)
    selected.vars <- order(importances, decreasing = TRUE)
    ranked_features = feature_names[selected.vars]
    ordered.importances <- importances[selected.vars]
    
    return(ranked_features)
}

feature_elimination

feature_elimination <- function(h,total_numof_eliminated_vars,ranked_features){ 
    numof_columns_left = length(ranked_features) - (total_numof_eliminated_vars + h)
    columns_left = ranked_features[1:numof_columns_left]
    
    eliminated_columns = setdiff((length(ranked_features) - total_numof_eliminated_vars), numof_columns_left)
    eliminated_columns = ranked_features[eliminated_columns]
    
    # update total_numof_eliminated_vars
    total_numof_eliminated_vars = length(ranked_features) - length(columns_left)
    
    return(list(columns_left,total_numof_eliminated_vars,h,eliminated_columns))
 }

Generate Unlabeled Data Pool

Latin hyper cube sampling

if(GenerateTTData == 1){
    unlabeled_pool = as.data.table(maximinLHS(n = unlabeled_ins, k = nofparams, dup = 5))
    
    unlabeled_pool$V1 = qunif(unlabeled_pool$V1, 10, 90) 
    unlabeled_pool$V2 = qunif(unlabeled_pool$V2, 10, 90) 
    setnames(unlabeled_pool, c(paste0("V",1:nofparams)), feature_names)
    
    unlabeled_pool[,idx := 1:.N]
        
    fwrite(unlabeled_pool, paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/unlabeled_pool_",Sys.Date(),".csv"))
}else{
    unlabeled_pool <- fread("C:/Users/paslanpatir/Desktop/TEZ_v2/unlabeled_pool_04122019.csv")   
    unlabeled_pool <- head(unlabeled_pool[`%-similar-wanted` < 90 & `density` < 90],700) 
}

pca_unlabeled_pool <- princomp(unlabeled_pool[,-c("idx")], cor = TRUE, scores = TRUE)
pca_unlabeled_pool_components <- get_pca_ind(pca_unlabeled_pool)
p_unlabeled_pool <- ggplot(data = data.table(pca_unlabeled_pool_components$coord[,1:2]), aes(x = Dim.1, y = Dim.2)) +
                    geom_point() +
                    labs( title = "") 
p_unlabeled_pool

Generate Test Set

if(GenerateTTData == 1){
    test_set <- head(unlabeled_pool,test_ins)
    
    ################## Buraya variale'ların datatipine göre bir şeyler yazılabilir
    test_set$density            = runif(test_ins, 10, 90) 
    test_set$`%-similar-wanted` = runif(test_ins, 10, 90) 
    test_set[,c("idx"):= NULL]
       
    print(paste0("ABM run start time : ",Sys.time()))
    test_set = run_ABM(nofrep,test_ins,test_set) %>% as.data.table()
    print(paste0("ABM run end time : ",Sys.time()))
    
    fwrite(test_set, paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/test_set_",Sys.Date(),".csv"))
}else{
    test_set <- fread("C:/Users/paslanpatir/Desktop/TEZ_v2/test_set_04122019.csv")  
    #below part is only for this .csv
    test_set <- head(test_set[`%-similar-wanted` < 90],800) 
    
    test_set[,idx := 1:.N]    
    test_set_idx = sample(test_set$idx, test_ins, replace = FALSE, prob = NULL)   
    test_set = test_set[idx %in% test_set_idx]
    test_set[,idx:= NULL]
}

10 10 ~ 1 min 100 10 ~ 14 min 900 * 10 ~ 09:16 -- 2019-12-03 07:54:10 +03"

pca_test_set <- princomp(test_set, cor = TRUE, scores = TRUE)
pca_test_set_components <- get_pca_ind(pca_test_set)
p_test_set <- ggplot(data = data.table(pca_test_set_components$coord[,1:2]), aes(x = Dim.1, y = Dim.2)) +
                    geom_point() +
                    labs( title = "") 
p_test_set

Benchmark : One-shot sampling, No feature elimination

Generate Training Set

Select a very big data pool ( nofinstances should be very high ) , like 1000

if(GenerateTTData == 1){
    training_set = as.data.table(maximinLHS(n = train_ins_oneshot, k = nofparams, dup = 5))
    
    training_set$V1 = qunif(training_set$V1, 10, 90) 
    training_set$V2 = qunif(training_set$V2, 10, 90) 
    setnames(training_set, c(paste0("V",1:nofparams)), feature_names)
    
    training_set$output <- 0.00
    
    print(paste0("ABM run start time : ",Sys.time()))
    training_set = run_ABM(nofrep,train_ins_oneshot,LHSample) %>% as.data.table()
    print(paste0("ABM run end time : ",Sys.time()))  
    
    fwrite(training_set, paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/training_set_",Sys.Date(),".csv"))
    
}else{
    training_set <- fread("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Data_04122019.csv")
    training_set <- head(training_set[`%-similar-wanted` < 90],700)
}

one_shot_data = copy(training_set)

Visualization

pca_training_set <- princomp(training_set[,.SD, .SDcols = !c("output")], cor = TRUE, scores = TRUE)

pca_training_set_components <- get_pca_ind(pca_training_set)
pca_training_set_components <-cbind(pca_training_set_components$coord[,1:2],training_set[,.SD, .SDcols = c("output")])
p_training_set <- ggplot(data = pca_training_set_components, aes(x = Dim.1, y = Dim.2)) +
             geom_point(aes(colour = output)) +
             labs( title = "", legend = "output") 
p_training_set

Train & Test Metamodel

model_oneshot <- randomForest(x = training_set[, -c("output")], y = training_set$output, importance = TRUE,ntree = ntree, mtry = mtry)
model_oneshot

Call:
 randomForest(x = training_set[, -c("output")], y = training_set$output,      ntree = ntree, mtry = mtry, importance = TRUE) 
               Type of random forest: regression
                     Number of trees: 400
No. of variables tried at each split: 2

          Mean of squared residuals: 9.100652
                    % Var explained: 96.98

obb_error_oneshot <- obb_error_func(model_oneshot)

#OBB_pred = cbind(training_set$output,model_oneshot$predicted)
#names(OBB_pred) <- c("actual","predicted")

plot(model_oneshot$mse, type="l")

test_prediction_oneshot = get_test_predictions(model_oneshot,test_set,error_type)
predictedLabels_oneshot = test_prediction_oneshot[[1]]

performance_table_oneshot = data.table(iter = numeric(), mae= numeric(),rmse= numeric(), mape = numeric())
# Keep test set error records
performance_table_oneshot = rbind(performance_table_oneshot, data.table(1, test_prediction_oneshot[[2]]), use.names = FALSE)

output_variables = test_prediction_oneshot[[3]]

performance_table_oneshot
obb_error_oneshot
head(predictedLabels_oneshot)

A data.table: 1 × 4

iter	mae	rmse	mape
<dbl>	<dbl>	<dbl>	<dbl>
1	0.8952435	2.411626	1.248689

9.10065150263321

A data.table: 6 × 5

density	%-similar-wanted	output	pred_output	RMSE
<dbl>	<dbl>	<dbl>	<dbl>	<dbl>
89.39026	63.87711	98.25157	97.75713	0.494433300
39.27182	36.46039	86.97693	86.34774	0.629181238
30.17455	57.23629	98.35179	98.45903	0.107241895
28.12210	68.05564	99.86504	99.86265	0.002391377
80.09701	42.18455	82.70191	83.97543	1.273523215
67.68955	15.81212	54.62473	54.36498	0.259752578

p_oneshot <- ggplot(predictedLabels_oneshot,aes(x = get(output_variables[1]), y = get(output_variables[2]), color = (get(output_variables[2]) - get(output_variables[1])))) +
            geom_point() +
            geom_abline() +
            xlab("actual values") +
            ylab("fitted values")

p_oneshot

Random Sampling & No Feature Elimination

Generate Training Set

Select a relatively big data pool ( nofinstances should be medium) , like 400

if(GenerateTTData == 1){
   
    training_set_Ad = as.data.table(maximinLHS(n = train_ins_Ad, k = nofparams, dup = 5))
    
    training_set_Ad$V1 = qunif(training_set_Ad$V1, 10, 90) 
    training_set_Ad$V2 = qunif(training_set_Ad$V2, 10, 90) 
    setnames(training_set_Ad, c(paste0("V",1:nofparams)), feature_names)
    training_set_Ad$output <- 0.00
    
    print(paste0("ABM run start time : ",Sys.time()))
    training_set_Ad = run_ABM(nofrep,train_ins_Ad,training_set_Ad) %>% as.data.table()
    print(paste0("ABM run end time : ",Sys.time()))
    
    fwrite(training_set_Ad, paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Ad_Data",Sys.Date(),".csv"))

}else{
    training_set_Ad <- fread("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Ad_Data_04122019.csv")
    training_set_Ad <- head(training_set_Ad[`%-similar-wanted` < 90  & `density` < 90],200)

}

adaptive_initial_data = copy(training_set_Ad)

Train & Test Metamodel

# Decide on strategy:
#iteration_budget = 3   #specified above

## initialize record tables Record train candidates
train_candidates_table = data.table()

# Record model performances
performance_table = data.table(iter = numeric(), mae = numeric(), rmse = numeric(), mape = numeric())

# Record obb_error table
obb_error = data.table(iter = numeric(), obb_error = numeric())

## initialize variables
# keep test set undistorted
predictedLabels_table = copy(test_set)

print(paste0("section start time : ",Sys.time()))
iter = 1
while(iter <= iteration_budget){   
    print(iter)

    trainx = training_set_Ad[,.SD, .SDcols = feature_names]
    trainy = training_set_Ad$output
    
    # Train the model
    model_Sub <- randomForest( x = trainx, y =  trainy,importance = TRUE,ntree = ntree, mtry = mtry)
    assign(paste0("model_Sub_",iter),model_Sub)
                     
    obb_error = rbind(obb_error,data.table(iter,obb_error_func(model_Sub)),use.names=FALSE)
    
    # test the model on test set
    test_predictions_Sub = get_test_predictions(model_Sub,test_set,error_type)
    predictedLabels_Sub = test_predictions_Sub[[1]]
    setnames(predictedLabels_Sub,c("pred_output",error_type), c(paste0("pred_output_",iter),paste0(error_type,"_",iter)))    
    predictedLabels_table = cbind(predictedLabels_table,predictedLabels_Sub[,.SD, .SDcols = c(paste0("pred_output_",iter),paste0(error_type,"_",iter))])
    
    # Keep test set error records
    performance_table = rbind(performance_table,data.table(iter,test_predictions_Sub[[2]]), use.names = FALSE)    

    if(iter != iteration_budget){ # below efforts are unnecessary when the budget is reached.
        
    ## sample selection from unlabeled data select candidates
    unlabeled_set <- copy(unlabeled_pool)
    train_candidates = random_sample_selection(selected_ins,unlabeled_set)
        
    # Eliminate train candidates from the unlabeled pool
    unlabeled_pool = unlabeled_pool[- train_candidates$idx]
    rm(unlabeled_set)
    
    # run ABM to find outputs of train candidates
    print(paste0("ABM train_candidate run start time : ",Sys.time()))
    train_candidates = run_ABM(nofrep,selected_ins,train_candidates)
    print(paste0("ABM train_candidate run end time : ",Sys.time()))
    
    train_candidates_table = rbind(train_candidates_table, data.table(train_candidates,iter = iter))

    # Add new data to train data
    training_set_Ad = rbind(training_set_Ad,train_candidates[,-c("idx")])
    }
    iter = iter + 1
}

# plot koy her iteration'da göstersin.
#setcolorder(data,variableorder) ################# bunu bi yerlere koyman gerekebilir, dikkat!!
print(paste0("section end time : ",Sys.time()))

[1] 1
[1] "ABM train_candidate run start time : 2020-01-08 20:13:23"
[1] "ABM train_candidate run end time : 2020-01-08 20:14:18"
[1] 2
[1] "ABM train_candidate run start time : 2020-01-08 20:14:19"
[1] "ABM train_candidate run end time : 2020-01-08 20:15:37"
[1] 3
[1] "ABM train_candidate run start time : 2020-01-08 20:15:38"
[1] "ABM train_candidate run end time : 2020-01-08 20:16:10"
[1] 4
[1] "ABM train_candidate run start time : 2020-01-08 20:16:10"
[1] "ABM train_candidate run end time : 2020-01-08 20:16:55"
[1] 5
[1] "ABM train_candidate run start time : 2020-01-08 20:16:55"
[1] "ABM train_candidate run end time : 2020-01-08 20:18:44"
[1] 6
[1] "ABM train_candidate run start time : 2020-01-08 20:18:44"
[1] "ABM train_candidate run end time : 2020-01-08 20:20:43"
[1] 7
[1] "ABM train_candidate run start time : 2020-01-08 20:20:43"
[1] "ABM train_candidate run end time : 2020-01-08 20:21:47"
[1] 8
[1] "ABM train_candidate run start time : 2020-01-08 20:21:47"
[1] "ABM train_candidate run end time : 2020-01-08 20:22:19"
[1] 9
[1] "ABM train_candidate run start time : 2020-01-08 20:22:19"
[1] "ABM train_candidate run end time : 2020-01-08 20:22:46"
[1] 10
[1] "ABM train_candidate run start time : 2020-01-08 20:22:46"
[1] "ABM train_candidate run end time : 2020-01-08 20:23:49"
[1] 11
[1] "ABM train_candidate run start time : 2020-01-08 20:23:49"
[1] "ABM train_candidate run end time : 2020-01-08 20:24:13"
[1] 12
[1] "ABM train_candidate run start time : 2020-01-08 20:24:14"
[1] "ABM train_candidate run end time : 2020-01-08 20:25:20"
[1] 13
[1] "ABM train_candidate run start time : 2020-01-08 20:25:20"
[1] "ABM train_candidate run end time : 2020-01-08 20:26:33"
[1] 14
[1] "ABM train_candidate run start time : 2020-01-08 20:26:33"
[1] "ABM train_candidate run end time : 2020-01-08 20:26:55"
[1] 15
[1] "ABM train_candidate run start time : 2020-01-08 20:26:55"
[1] "ABM train_candidate run end time : 2020-01-08 20:27:58"
[1] 16
[1] "ABM train_candidate run start time : 2020-01-08 20:27:59"
[1] "ABM train_candidate run end time : 2020-01-08 20:28:21"
[1] 17
[1] "ABM train_candidate run start time : 2020-01-08 20:28:21"
[1] "ABM train_candidate run end time : 2020-01-08 20:29:28"
[1] 18
[1] "ABM train_candidate run start time : 2020-01-08 20:29:28"
[1] "ABM train_candidate run end time : 2020-01-08 20:30:46"
[1] 19
[1] "ABM train_candidate run start time : 2020-01-08 20:30:46"
[1] "ABM train_candidate run end time : 2020-01-08 20:31:12"
[1] 20

started : 2020-01-08 20:13:23 // ended : 2020-01-08 20:31:12 // 10 nofrep 5 sample 19 selection iter = 950 runs

# Final records
FinalTrainData_Rd = copy(training_set_Ad)
performance_table_Rd = copy(performance_table)
train_candidates_table_Rd  = copy(train_candidates_table)
predictedLabels_table_Rd = copy(predictedLabels_table)
obb_error_Rd = copy(obb_error)

#fwrite(FinalTrainData_Rd,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/FinalTrainData_Rd_BasicCode_",Sys.Date(),".csv") )
#fwrite(performance_table_Rd,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/performance_table_Rd_BasicCode_",Sys.Date(),".csv") )
#fwrite(train_candidates_table_Rd,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/train_candidates_table_Rd_BasicCode_",Sys.Date(),".csv") )
#fwrite(predictedLabels_table_Rd,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/predictedLabels_table_Rdd_BasicCode_",Sys.Date(),".csv") )
#fwrite(obb_error_Rd,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/obb_error_Rd_BasicCode_",Sys.Date(),".csv") )

# show results
nrow(FinalTrainData_Rd)
performance_table_Rd 
train_candidates_table_Rd  
head(predictedLabels_table_Rd)
obb_error_Rd

295

A data.table: 20 × 4

iter	mae	rmse	mape
<dbl>	<dbl>	<dbl>	<dbl>
1	1.979057	4.630951	2.892140
2	1.956142	4.566450	2.842396
3	1.931075	4.551489	2.807515
4	1.880098	4.509183	2.745856
5	1.818918	4.442963	2.652534
6	1.840265	4.479181	2.686348
7	1.815143	4.384454	2.655121
8	1.765295	4.340163	2.572454
9	1.839589	4.465441	2.688164
10	1.777855	4.369182	2.591287
11	1.808210	4.406184	2.630731
12	1.793010	4.384207	2.611763
13	1.770857	4.390075	2.595782
14	1.708668	4.306637	2.489076
15	1.708068	4.277594	2.489050
16	1.653790	4.246318	2.408060
17	1.685095	4.277575	2.459884
18	1.667527	4.269824	2.432956
19	1.664338	4.279799	2.434972
20	1.642367	4.234445	2.402899

A data.table: 95 × 5

density	%-similar-wanted	idx	output	iter
<dbl>	<dbl>	<int>	<dbl>	<dbl>
42.77812	53.75968	274	97.11403	1
78.71842	22.11861	305	60.22435	1
34.35459	59.93100	319	97.94375	1
71.01396	10.83699	661	52.59528	1
46.87704	83.27465	690	53.82823	1
84.83937	49.62663	23	86.99513	2
61.35303	75.38737	173	58.26352	2
42.24831	44.08915	201	90.50809	2
12.56894	24.55212	368	87.04368	2
81.46588	68.22423	611	99.53528	2
33.27589	49.22701	64	91.40708	3
24.27906	33.68830	323	91.81992	3
27.31636	10.91680	381	69.27764	3
46.07824	53.19115	540	96.56119	3
51.54346	34.70113	683	82.55383	3
34.60035	72.34013	58	99.83484	4
47.21922	69.72505	79	99.64341	4
16.22877	54.71711	129	99.51134	4
78.97143	25.37043	227	64.33465	4
77.94365	32.22095	516	72.50134	4
14.51209	52.86507	3	99.69322	5
13.69790	16.21130	249	85.04399	5
42.06010	12.32076	483	59.11218	5
56.65876	42.57646	520	86.45216	5
85.84484	88.20989	527	50.10314	5
83.06408	79.42206	116	52.40023	6
41.83807	78.67310	167	79.52131	6
76.92746	12.88288	286	52.24238	6
18.79723	79.67726	454	94.03960	6
86.47605	54.01093	643	94.01935	6
...	...	...	...	...
15.13944	74.06980	3	100.00000	14
17.84703	21.11220	29	79.39083	14
75.07979	52.73906	44	93.98682	14
21.60726	85.95121	378	75.28733	14
38.55994	11.12222	614	61.54648	14
52.34823	46.21328	31	88.90773	15
56.35122	12.24678	251	54.68649	15
63.23602	84.93076	338	51.46734	15
15.32172	25.76877	428	88.24107	15
49.34554	69.43317	625	99.72617	15
28.97988	35.44827	144	90.02338	16
32.08672	13.03629	303	65.39747	16
37.82167	27.35264	432	76.81702	16
20.92371	58.18562	494	99.23036	16
25.86486	51.16387	546	98.84031	16
37.27228	18.42808	91	63.20990	17
20.98484	80.97271	160	80.73596	17
45.38751	35.70500	249	84.18982	17
88.80344	41.15310	467	82.62831	17
38.80837	66.89394	588	99.79249	17
41.97049	55.20956	3	97.18123	18
36.37558	37.53732	136	86.63141	18
26.15834	27.99602	176	80.00681	18
64.04235	69.77663	383	99.64751	18
73.47166	82.75609	483	52.15003	18
34.24868	64.31899	57	98.91529	19
56.88269	64.81723	384	98.51857	19
53.50015	31.99233	394	73.91483	19
34.89065	14.04983	484	63.40551	19
30.29522	48.18946	576	91.78666	19

A data.table: 6 × 43

density	%-similar-wanted	output	pred_output_1	RMSE_1	pred_output_2	RMSE_2	pred_output_3	RMSE_3	pred_output_4	...	pred_output_16	RMSE_16	pred_output_17	RMSE_17	pred_output_18	RMSE_18	pred_output_19	RMSE_19	pred_output_20	RMSE_20
<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	...	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>
89.39026	63.87711	98.25157	98.06402	0.187545282	98.08132	0.170244396	98.08747	0.16409834	98.06799	...	98.01415	0.23741839	98.01841	0.233156007	98.04251	0.209053157	97.99876	0.252806699	98.00840	0.24316723
39.27182	36.46039	86.97693	84.97106	2.005869214	84.90012	2.076805439	85.10050	1.87642772	85.64263	...	86.08505	0.89187294	86.56031	0.416612980	87.00784	0.030919066	86.62933	0.347596744	86.62736	0.34956716
30.17455	57.23629	98.35179	98.48519	0.133394827	98.44711	0.095312497	98.50791	0.15612052	98.41732	...	98.47899	0.12719825	98.49618	0.144389397	98.53098	0.179191231	98.44722	0.095425776	98.51125	0.15946007
28.12210	68.05564	99.86504	99.86735	0.002302821	99.87464	0.009599013	99.87650	0.01145507	99.86329	...	99.86814	0.00309612	99.85951	0.005529374	99.86785	0.002802866	99.86740	0.002353862	99.87838	0.01333793
80.09701	42.18455	82.70191	85.34628	2.644370261	85.21836	2.516445763	85.30794	2.60602533	85.42648	...	85.89805	3.19614225	85.75223	3.050323586	85.50740	2.805493330	85.67141	2.969501805	85.60929	2.90737641
67.68955	15.81212	54.62473	57.18231	2.557578028	57.20784	2.583107362	56.90128	2.27654809	56.99056	...	56.62537	2.00063988	56.29790	1.673163597	56.39057	1.765837822	56.53687	1.912140451	56.42842	1.80369009

A data.table: 20 × 2

iter	obb_error
<dbl>	<dbl>
1	13.698624
2	12.575650
3	11.546581
4	10.946875
5	10.486905
6	9.954476
7	9.179074
8	8.386098
9	8.878509
10	8.073575
11	8.115914
12	7.367993
13	7.798472
14	6.945190
15	7.121243
16	6.084151
17	6.817448
18	5.652835
19	6.150030
20	5.816591

performance_molten_Rd <- melt(data = performance_table_Rd
                             , id.vars = 'iter')
setnames(performance_molten_Rd, c("variable","value"),c("errortype","errorvalue"))
p_Rd = ggplot(performance_molten_Rd, aes(x = iter, y = errorvalue, group=errortype, col=errortype)) + 
          geom_line(lwd=1)
p_Rd

Adaptive Sampling & No Feature Elimination

Generate Training Set

Select a relatively big data pool ( nofinstances should be medium) , like 400

training_set_Ad = copy(adaptive_initial_data)

#if(GenerateTTData == 1){
#   
#    LHSample_Ad = as.data.table(maximinLHS(n = train_ins_Ad, k = nofparams, dup = 5))
#    
#    LHSample_Ad$V1 = qunif(LHSample_Ad$V1, 10, 90) 
#    LHSample_Ad$V2 = qunif(LHSample_Ad$V2, 10, 90) 
#    setnames(LHSample_Ad, c("V1","V2"), feature_names)
#    LHSample_Ad$output <- 0.00
#    
#    paste0("ABM run start time : ",Sys.time())
#    LHSample_Ad = run_ABM(nofrep,train_ins_Ad,LHSample_Ad) %>% as.data.table()
#    paste0("ABM run end time : ",Sys.time())
#    
#    fwrite(LHSample_Ad, paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Ad_Data",Sys.Date(),".csv"))
#
#}else{
#    LHSample_Ad <- fread("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Ad_Data_04122019.csv")
#    LHSample_Ad <- head(LHSample_Ad[`%-similar-wanted` < 90  & `density` < 90],200)
#
#}

Visualization

pca_training_set_Ad <- princomp(training_set_Ad[,-c("output")], cor = TRUE, scores = TRUE)

#fviz_pca_ind(pca_LHSample,
#             col.ind = "cos2", # Color by the quality of representation
#             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
#              geom="point"
#             )

pca_training_set_Ad_components <- get_pca_ind(pca_training_set_Ad)
pca_training_set_Ad_components <-cbind(pca_training_set_Ad_components$coord[,1:2],training_set_Ad[,c("output")])
p_training_set_Ad <- ggplot(data = pca_training_set_Ad_components, aes(x = Dim.1, y = Dim.2)) +
                     geom_point(aes(colour = output)) +
                     labs( title = "", legend = "output") 
p_training_set_Ad

Train & Test Metamodel

# Decide on strategy:
#iteration_budget = 3

#h = 1 # specify how many variable will be eliminated in each elimination iteration

## initialize record tables Record train candidates
train_candidates_table = data.table()

# Record model performances
performance_table = data.table(iter = numeric(), mae = numeric(), rmse = numeric(), mape = numeric())

# Record obb_error table
obb_error = data.table(iter = numeric(), obb_error = numeric())

## initialize variables
# keep test set undistorted
predictedLabels_table = copy(test_set)

print(paste0("section start time : ",Sys.time()))
iter = 1
while(iter <= iteration_budget){   
    print(iter)

    trainx = training_set_Ad[,.SD, .SDcols = feature_names]
    trainy = training_set_Ad$output
    
    # Train the model
    model_Sub <- randomForest( x = trainx, y =  trainy,importance = TRUE,ntree = ntree, mtry = mtry)
    assign(paste0("model_Sub_",iter),model_Sub)
                    
    obb_error = rbind(obb_error,data.table(iter,obb_error_func(model_Sub)),use.names=FALSE)

    # test the model on test set
    test_predictions_Sub = get_test_predictions(model_Sub,test_set,error_type)
    predictedLabels_Sub = test_predictions_Sub[[1]]
    setnames(predictedLabels_Sub,c("pred_output",error_type), c(paste0("pred_output_",iter),paste0(error_type,"_",iter)))    
    predictedLabels_table = cbind(predictedLabels_table,predictedLabels_Sub[,.SD, .SDcols = c(paste0("pred_output_",iter),paste0(error_type,"_",iter))])
    
    # Keep test set error records
    performance_table = rbind(performance_table,data.table(iter,test_predictions_Sub[[2]]), use.names = FALSE)
    
    if(iter != iteration_budget){ # below efforts are unnecessary when the budget is reached.    
    ## sample selection from unlabeled data select candidates
        unlabeled_set <- copy(unlabeled_pool)
        train_candidates = sample_selection(selected_ins, unlabeled_set, model_Sub)
        
        # eliminate candidates from the unlabeled pool
        unlabeled_pool = unlabeled_pool[-train_candidates$idx]
        rm(unlabeled_set)
        
        # run ABM to find outputs of train candidates
        print(paste0("ABM train_candidate run start time : ",Sys.time()))
        train_candidates = run_ABM(nofrep, selected_ins, train_candidates)
        print(paste0("ABM train_candidate run end time : ",Sys.time()))
        
        train_candidates_table = rbind(train_candidates_table, data.table(train_candidates,iter = iter))
        
        # add labeled candidates to the train data
        training_set_Ad = rbind(training_set_Ad, train_candidates[, -c("idx")])
    }
    iter = iter + 1
}
print(paste0("section end time : ",Sys.time()))

[1] "2020-01-08 20:43:07 +03"
[1] 1
[1] 2
[1] 3
[1] 4
[1] 5
[1] 6
[1] 7
[1] 8
[1] 9
[1] 10
[1] 11
[1] 12
[1] 13
[1] 14
[1] 15
[1] 16
[1] 17
[1] 18
[1] 19
[1] 20

# Final records
FinalTrainData_Ad = copy(training_set_Ad)
performance_table_Ad = copy(performance_table)
train_candidates_table_Ad  = copy(train_candidates_table)
predictedLabels_table_Ad = copy(predictedLabels_table)
obb_error_Ad = copy(obb_error)

#fwrite(FinalTrainData_Ad,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/FinalTrainData_Ad_BasicCode_",Sys.Date(),".csv") )
#fwrite(performance_table_Ad,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/performance_table_Ad_BasicCode_",Sys.Date(),".csv") )
#fwrite(train_candidates_table_Ad,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/train_candidates_table_Ad_BasicCode_",Sys.Date(),".csv") )
#fwrite(predictedLabels_table_Ad,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/predictedLabels_table_Ad_BasicCode_",Sys.Date(),".csv") )
#fwrite(obb_error_Ad,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/obb_error_Ad_BasicCode_",Sys.Date(),".csv") )

nrow(FinalTrainData_Ad)
performance_table_Ad
train_candidates_table_Ad
head(predictedLabels_table_Ad)
obb_error_Ad

295

A data.table: 20 × 4

iter	mae	rmse	mape
<dbl>	<dbl>	<dbl>	<dbl>
1	1.953107	4.550709	2.851815
2	1.875282	4.466453	2.785134
3	1.726252	4.210574	2.507212
4	1.703510	4.183790	2.467414
5	1.736235	4.206643	2.520176
6	1.659961	4.086685	2.431520
7	1.628921	4.064637	2.388690
8	1.560716	3.903607	2.298264
9	1.564209	3.918014	2.308238
10	1.550733	3.921976	2.281406
11	1.508600	3.888082	2.221079
12	1.494517	3.860778	2.194536
13	1.529449	3.883419	2.248281
14	1.480985	3.840514	2.181458
15	1.478601	3.878881	2.183937
16	1.455349	3.861696	2.151844
17	1.414907	3.848212	2.096413
18	1.375267	3.820853	2.036647
19	1.395494	3.832382	2.070172
20	1.387428	3.822572	2.063110

A data.table: 95 × 5

density	%-similar-wanted	idx	output	iter
<dbl>	<dbl>	<int>	<dbl>	<dbl>
52.51502	74.99535	116	99.74772	1
66.32434	74.85613	168	99.75318	1
79.18638	74.59114	444	81.75518	1
38.04839	74.89497	237	99.81041	1
17.79868	75.83541	210	98.80636	1
49.52896	75.20317	12	68.80220	2
57.48774	75.70978	272	60.82892	2
63.69882	76.08750	231	59.07034	2
54.75810	76.58287	262	64.39071	2
70.47861	76.76088	49	55.41188	2
22.23156	89.17194	474	71.96950	3
23.96343	87.89434	67	70.15055	3
23.16292	82.28575	397	71.02702	3
25.23382	89.59882	296	63.58299	3
25.55510	82.89269	119	66.41017	3
18.66068	86.56811	33	88.44646	4
20.37012	75.14078	443	94.16283	4
32.15096	76.26948	388	82.25291	4
41.29254	75.91780	534	73.04268	4
19.79348	83.22548	551	84.45996	4
75.24774	75.33341	517	53.86521	5
33.83885	79.30846	153	82.54022	5
14.15759	13.42712	461	84.20743	5
12.27218	12.10815	16	87.78443	5
17.29939	10.16686	581	79.45871	5
29.08568	80.77893	143	60.62795	6
17.95568	88.87073	579	92.26585	6
44.26975	79.53293	488	73.04231	6
35.43042	77.53684	532	80.36247	6
29.26148	78.01998	422	83.83329	6
...	...	...	...	...
89.37628	67.27177	180	98.11815	14
89.01762	56.11732	338	94.64405	14
22.61929	14.09972	175	73.33147	14
89.67565	52.96523	311	94.11101	14
28.58847	83.86143	374	62.10554	14
22.88652	25.02460	37	81.95918	15
75.62214	28.38348	275	65.38261	15
63.82651	79.28610	178	58.27943	15
67.39082	72.71155	109	99.64980	15
22.52901	27.04430	304	82.02778	15
25.30662	25.56910	457	80.65328	16
87.27561	28.73142	339	73.64735	16
33.59343	32.95049	262	78.98350	16
37.38967	33.93330	20	86.73381	16
40.09369	13.92735	139	60.97599	16
28.08115	25.41423	215	80.00305	17
31.76051	26.41215	372	78.80194	17
77.59878	77.15022	264	53.16503	17
35.02280	27.87709	192	77.94151	17
49.50549	89.36927	220	51.89244	17
26.07845	77.40225	233	85.56888	18
16.94409	85.47096	329	98.21741	18
43.38667	22.75769	10	66.92977	18
11.62956	88.38036	130	100.00000	18
21.93770	16.78390	487	76.03644	18
40.05386	25.70328	184	76.03995	19
24.96805	74.65329	430	99.92737	19
45.98137	81.18073	77	54.46483	19
35.32615	24.68971	511	68.69978	19
31.98782	23.78817	95	71.07999	19

A data.table: 6 × 43

density	%-similar-wanted	output	pred_output_1	RMSE_1	pred_output_2	RMSE_2	pred_output_3	RMSE_3	pred_output_4	...	pred_output_16	RMSE_16	pred_output_17	RMSE_17	pred_output_18	RMSE_18	pred_output_19	RMSE_19	pred_output_20	RMSE_20
<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	...	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>
89.39026	63.87711	98.25157	97.96700	0.28456878	97.93461	0.31695520	97.89181	0.35975859	97.89960	...	97.66839	0.58317363	97.91983	0.33174105	97.85828	0.39328374	97.80421	0.44735468	97.76081	0.49075851
39.27182	36.46039	86.97693	84.81302	2.16390289	84.80484	2.17208560	84.99938	1.97754891	84.73263	...	86.13467	0.84225057	86.27577	0.70115211	86.35256	0.62436276	86.33660	0.64032388	86.15362	0.82330789
30.17455	57.23629	98.35179	98.44241	0.09061833	98.46882	0.11702316	98.51246	0.16067101	98.44729	...	98.46462	0.11282847	98.43149	0.07970119	98.46832	0.11653048	98.39567	0.04387479	98.47900	0.12720653
28.12210	68.05564	99.86504	99.87947	0.01442811	99.88698	0.02193582	99.88912	0.02407434	99.88278	...	99.88194	0.01690062	99.88221	0.01716625	99.88118	0.01614016	99.87755	0.01250931	99.87718	0.01213288
80.09701	42.18455	82.70191	85.21690	2.51498586	85.33270	2.63078700	85.35535	2.65343512	85.21777	...	85.31477	2.61285542	85.15725	2.45533579	85.23329	2.53137588	85.11445	2.41253469	85.36155	2.65964143
67.68955	15.81212	54.62473	57.26408	2.63934660	57.23917	2.61443525	57.03367	2.40893645	56.92696	...	56.68632	2.06158563	56.35183	1.72710016	56.47459	1.84986286	56.43682	1.81208895	56.51362	1.88888368

A data.table: 20 × 2

iter	obb_error
<dbl>	<dbl>
1	13.023629
2	20.357446
3	12.220124
4	11.424621
5	12.597000
6	12.687486
7	12.313131
8	12.657531
9	12.398615
10	11.619570
11	12.149426
12	10.130318
13	9.809643
14	9.592774
15	10.050909
16	9.763462
17	8.740436
18	9.116479
19	8.536941
20	8.507114

performance_molten_Ad <- melt(data = performance_table_Ad
                             , id.vars = 'iter')
setnames(performance_molten_Ad, c("variable","value"),c("errortype","errorvalue"))
p_Ad = ggplot(performance_molten_Ad, aes(x = iter, y = errorvalue, group=errortype, col=errortype)) + 
            geom_line(lwd=1)
p_Ad

Random Sampling vs Uncertainty Sampling

grid.arrange(p_Rd, p_Ad, ncol=2)

performance_molten_oneshot <- melt(data = performance_table_oneshot
                             , id.vars = 'iter')
setnames(performance_molten_oneshot, c("variable","value"),c("errortype","errorvalue"))

performance_Rd_vs_Ad = rbind(performance_molten_Rd[,.(iter,errortype,errorvalue, type = "Rd")],performance_molten_Ad[,.(iter,errortype,errorvalue, type = "Ad")])
p_Rd_vs_Ad = ggplot(performance_Rd_vs_Ad, aes(x = iter, y = errorvalue, group=errortype, col=errortype)) + 
            geom_line(lwd=1) +
            geom_hline(data = performance_molten_oneshot, aes(yintercept = errorvalue, group=errortype, col=errortype),stat = "hline", linetype = "dashed") +
            facet_wrap(~type)
p_Rd_vs_Ad

ggplotly(p_Rd_vs_Ad)

comp = performance_Rd_vs_Ad[iter == 20 & errortype =="rmse"]
comp[, oneshot_error := performance_molten_oneshot[errortype =="rmse"]$errorvalue]      
comp[,diff := (errorvalue - oneshot_error) ]
comp[,diff_perc := (errorvalue - oneshot_error) / oneshot_error ]
comp

A data.table: 2 × 7

iter	errortype	errorvalue	type	oneshot_error	diff	diff_perc
<dbl>	<fct>	<dbl>	<chr>	<dbl>	<dbl>	<dbl>
20	rmse	4.234445	Rd	2.411626	1.822819	0.7558461
20	rmse	3.822572	Ad	2.411626	1.410945	0.5850595

Adaptive Sampling & Feature Elimination

Generate Training Set

Select a relatively big data pool ( nofinstances should be medium) , like 400

training_set_Ad = copy(adaptive_initial_data)

#if(GenerateTTData == 1){
#   
#    LHSample_Ad = as.data.table(maximinLHS(n = train_ins_Ad, k = nofparams, dup = 5))
#    
#    LHSample_Ad$V1 = qunif(LHSample_Ad$V1, 10, 90) 
#    LHSample_Ad$V2 = qunif(LHSample_Ad$V2, 10, 90) 
#    setnames(LHSample_Ad, c("V1","V2"), feature_names)
#    LHSample_Ad$output <- 0.00
#    
#    paste0("ABM run start time : ",Sys.time())
#    LHSample_Ad = run_ABM(nofrep,train_ins_Ad,LHSample_Ad) %>% as.data.table()
#    paste0("ABM run end time : ",Sys.time())
#    
#    fwrite(LHSample_Ad, paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Ad_Data",Sys.Date(),".csv"))
#
#}else{
#    LHSample_Ad <- fread("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Ad_Data_04122019.csv")
#    LHSample_Ad <- head(LHSample_Ad[`%-similar-wanted` < 90  & `density` < 90],200)
#
#}

Visualization

pca_training_set_Ad <- princomp(training_set_Ad[,-c("output")], cor = TRUE, scores = TRUE)

#fviz_pca_ind(pca_LHSample,
#             col.ind = "cos2", # Color by the quality of representation
#             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
#              geom="point"
#             )

pca_training_set_Ad_components <- get_pca_ind(pca_training_set_Ad)
pca_training_set_Ad_components <-cbind(pca_training_set_Ad_components$coord[,1:2],training_set_Ad[,c("output")])
p_training_set_Ad <- ggplot(data = pca_training_set_Ad_components, aes(x = Dim.1, y = Dim.2)) +
                     geom_point(aes(colour = output)) +
                     labs( title = "", legend = "output") 
p_training_set_Ad

Train and Test Metamodel

# Decide on strategy:
sample_selection_iteration_order = c(1:19)
feature_elimination_iteration_order = c(19)
#iteration_budget = 3 # should be > max(max(sample_selection_iteration_order),max(feature_elimination_iteration_order))

#h = 1 # specify how many variable will be eliminated in each elimination iteration

feature_names

1. 'density'
2. '%-similar-wanted'

## initialize record tables Record train candidates
train_candidates_table = data.table()

# Record model performances
performance_table = data.table(iter = numeric(), mae = numeric(), rmse = numeric(), mape = numeric())

# Record obb_error table
obb_error = data.table(iter = numeric(), obb_error = numeric())

# Record iteration history
iteration_history = data.table(iter_no = numeric(), IsFeatureEliminated = logical(), IsDataSelected = logical())

## initialize variables
# keep test set undistorted
predictedLabels_table = copy(test_set)

# specify variables(columns) to be used initialize
columns_left = feature_names
total_numof_eliminated_vars <- 0

print(paste0("section start time : ",Sys.time()))
iter = 1
while (iter <= iteration_budget) {
    
    trainx = training_set_Ad[, .SD, .SDcols = columns_left]
    trainy = training_set_Ad$output
    
    # Train the model
    model_Sub <- randomForest(x = trainx, y = trainy, importance = TRUE, ntree = ntree, mtry = mtry)
    assign(paste0("model_Sub_", iter), model_Sub)
    
    if (length(columns_left) == length(feature_names)) {
        ranked_features = get_variable_importance(model_Sub)
    }
    # Keep training set error records
    obb_error = rbind(obb_error, data.table(iter, obb_error_func(model_Sub)), use.names = FALSE)
    
    # Test the model on test set
    test_predictions_Sub = get_test_predictions(model_Sub, test_set, error_type)
    predictedLabels_Sub = test_predictions_Sub[[1]]
    setnames(predictedLabels_Sub, c("pred_output", error_type), c(paste0("pred_output_", iter), paste0(error_type, "_", iter)))
    predictedLabels_table = cbind(predictedLabels_table, predictedLabels_Sub[,.SD, .SDcols = c(paste0("pred_output_", iter), paste0(error_type, "_", iter))])
    
    # Keep test set error records
    performance_table = rbind(performance_table, data.table(iter, test_predictions_Sub[[2]]), use.names = FALSE)
    
    # update iteration_history
    iteration_history = rbind(iteration_history, data.table(iter, 0, 0), use.names = FALSE)
    
    if(iter != iteration_budget){ # below efforts are unnecessary when the budget is reached.
          if (iter %in% sample_selection_iteration_order) {
              ## sample selection from unlabeled data select candidates
              unlabeled_set <- copy(unlabeled_pool)
              train_candidates = sample_selection(selected_ins, unlabeled_set, model_Sub)
              
              # eliminate candidates from the unlabeled pool
              unlabeled_pool = unlabeled_pool[-train_candidates$idx]
              rm(unlabeled_set)
              
              # run ABM to find outputs of train candidates
              print(paste0("ABM train_candidate run start time : ",Sys.time()))
              train_candidates = run_ABM(nofrep, selected_ins, train_candidates)
              print(paste0("ABM train_candidate run end time : ",Sys.time()))
              
              train_candidates_table = rbind(train_candidates_table, data.table(train_candidates,iter = iter))
              
              # add labeled candidates to the train data
              training_set_Ad = rbind(training_set_Ad, train_candidates[, -c("idx")])
              
              # update iteration_history
               iteration_history[iter]$IsDataSelected= 1
          }
          if (iter %in% feature_elimination_iteration_order) {
              ## feature elimination apply feature elimination
              feature_elimination_result = feature_elimination(h, total_numof_eliminated_vars, ranked_features)
              
              columns_left = feature_elimination_result[[1]]  # 
              eliminated_columns = feature_elimination_result[[4]]  #   not necessary
              total_numof_eliminated_vars = as.numeric(feature_elimination_result[2])
              numof_eliminated_vars = as.numeric(feature_elimination_result[3])  #   not necessary 
              
              # update iteration_history
              iteration_history[iter]$IsFeatureEliminated= 1
          }
    }
iter = iter + 1  
}
print(paste0("section end time : ",Sys.time()))

[1] "section start time : 2020-01-08 21:46:52"
[1] "ABM train_candidate run start time : 2020-01-08 21:46:52"
[1] "ABM train_candidate run end time : 2020-01-08 21:49:56"
[1] "ABM train_candidate run start time : 2020-01-08 21:49:56"
[1] "ABM train_candidate run end time : 2020-01-08 21:50:19"
[1] "ABM train_candidate run start time : 2020-01-08 21:50:19"
[1] "ABM train_candidate run end time : 2020-01-08 21:50:37"
[1] "ABM train_candidate run start time : 2020-01-08 21:50:38"
[1] "ABM train_candidate run end time : 2020-01-08 21:51:46"
[1] "ABM train_candidate run start time : 2020-01-08 21:51:46"
[1] "ABM train_candidate run end time : 2020-01-08 21:52:08"
[1] "ABM train_candidate run start time : 2020-01-08 21:52:08"
[1] "ABM train_candidate run end time : 2020-01-08 21:53:04"
[1] "ABM train_candidate run start time : 2020-01-08 21:53:04"
[1] "ABM train_candidate run end time : 2020-01-08 21:53:29"
[1] "ABM train_candidate run start time : 2020-01-08 21:53:29"
[1] "ABM train_candidate run end time : 2020-01-08 21:54:24"
[1] "ABM train_candidate run start time : 2020-01-08 21:54:25"
[1] "ABM train_candidate run end time : 2020-01-08 21:54:57"
[1] "ABM train_candidate run start time : 2020-01-08 21:54:58"
[1] "ABM train_candidate run end time : 2020-01-08 21:56:23"
[1] "ABM train_candidate run start time : 2020-01-08 21:56:23"
[1] "ABM train_candidate run end time : 2020-01-08 21:56:53"
[1] "ABM train_candidate run start time : 2020-01-08 21:56:53"
[1] "ABM train_candidate run end time : 2020-01-08 21:57:47"
[1] "ABM train_candidate run start time : 2020-01-08 21:57:47"
[1] "ABM train_candidate run end time : 2020-01-08 21:58:14"
[1] "ABM train_candidate run start time : 2020-01-08 21:58:14"
[1] "ABM train_candidate run end time : 2020-01-08 21:59:14"
[1] "ABM train_candidate run start time : 2020-01-08 21:59:14"
[1] "ABM train_candidate run end time : 2020-01-08 21:59:41"
[1] "ABM train_candidate run start time : 2020-01-08 21:59:41"
[1] "ABM train_candidate run end time : 2020-01-08 22:00:50"
[1] "ABM train_candidate run start time : 2020-01-08 22:00:50"
[1] "ABM train_candidate run end time : 2020-01-08 22:01:15"
[1] "ABM train_candidate run start time : 2020-01-08 22:01:15"
[1] "ABM train_candidate run end time : 2020-01-08 22:01:37"
[1] "ABM train_candidate run start time : 2020-01-08 22:01:37"
[1] "ABM train_candidate run end time : 2020-01-08 22:02:30"
[1] "section end time : 2020-01-08 22:02:30"

950 runs: "section start time : 2020-01-08 21:46:52" // "section end time : 2020-01-08 22:02:30"

#performance_error_table = performance_table[,.SD,.SDcols = c("iter",tolower(error_type))]
#setnames(performance_error_table,c("iter","error"))
#performance_error_table[, lag_error := shift(error,1,type = "lag")]
#performance_error_table
performance_error_table[.N]

columns_left

'%-similar-wanted'

# Final records
FinalTrainData_AdFe = copy(training_set_Ad)
performance_table_AdFe = copy(performance_table)
train_candidates_table_AdFe  = copy(train_candidates_table)
predictedLabels_table_AdFe = copy(predictedLabels_table)
obb_error_AdFe = copy(obb_error)

#fwrite(FinalTrainData_AdFe,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/FinalTrainData_AdFe_BasicCode_",Sys.Date(),".csv") )
#fwrite(performance_table_AdFe,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/performance_table_AdFe_BasicCode_",Sys.Date(),".csv") )
#fwrite(train_candidates_table_AdFe,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/train_candidates_table_AdFe_BasicCode_",Sys.Date(),".csv") )
#fwrite(predictedLabels_table_AdFe,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/predictedLabels_table_AdFe_BasicCode_",Sys.Date(),".csv") )
#fwrite(obb_error_AdFe,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/obb_error_AdFe_BasicCode_",Sys.Date(),".csv") )

nrow(FinalTrainData_AdFe)
performance_table_AdFe
train_candidates_table_AdFe
head(predictedLabels_table_AdFe)
obb_error_AdFe

295

A data.table: 20 × 4

iter	mae	rmse	mape
<dbl>	<dbl>	<dbl>	<dbl>
1	1.976288	4.562080	2.890032
2	1.847960	4.395894	2.633541
3	1.770368	4.285861	2.544732
4	1.760720	4.238648	2.533905
5	1.751490	4.250767	2.516850
6	1.671947	4.183803	2.425678
7	1.663493	4.197396	2.421337
8	1.657437	4.216653	2.414149
9	1.648544	4.198416	2.404775
10	1.620069	4.187699	2.356469
11	1.610693	4.178589	2.341866
12	1.595499	4.216997	2.320202
13	1.579449	4.160491	2.301436
14	1.583705	4.197575	2.308353
15	1.558521	4.168630	2.268622
16	1.582896	4.196428	2.309359
17	1.568282	4.194750	2.286266
18	1.556581	4.146407	2.253243
19	1.526085	4.145089	2.202216
20	6.359275	10.526088	9.407042

A data.table: 95 × 5

density	%-similar-wanted	idx	output	iter
<dbl>	<dbl>	<int>	<dbl>	<dbl>
82.76068	76.43015	114	52.74300	1
49.02309	77.00174	154	65.97506	1
72.41038	76.23947	158	54.44236	1
66.09709	77.64091	423	56.79119	1
89.25011	76.02308	330	51.84575	1
28.26225	89.73334	477	60.91972	2
27.82008	86.77187	241	62.00985	2
34.44622	74.35828	239	99.82555	2
17.28235	13.79890	273	79.89692	2
20.22223	13.09989	383	75.81525	2
11.46629	83.46279	230	100.00000	3
10.75115	80.23808	418	100.00000	3
13.79961	80.14878	241	100.00000	3
15.75655	77.87148	467	100.00000	3
13.97423	87.50010	397	100.00000	3
40.94773	82.62391	88	55.47737	4
40.19510	84.74781	388	53.75830	4
37.90111	83.14418	195	56.24323	4
10.01360	86.11170	454	100.00000	4
13.42041	36.25440	224	94.94334	4
11.88604	34.09181	70	95.90345	5
33.97894	36.86119	121	88.58720	5
35.66253	35.19057	385	87.79874	5
44.79137	13.29886	197	58.66438	5
10.93360	14.29982	214	91.98772	5
80.54534	71.36948	236	99.47793	6
50.20007	73.33066	363	99.75528	6
32.49947	19.08426	118	66.66141	6
10.84192	31.72772	408	93.31843	6
10.39393	17.20636	457	89.59915	6
...	...	...	...	...
45.25816	22.80078	270	65.82497	14
56.01141	26.68313	38	70.32907	14
54.19152	27.61548	297	71.40474	14
48.01636	22.27623	184	65.63261	14
72.03874	78.84159	359	54.46667	14
81.93879	28.89621	70	72.73828	15
47.92501	24.76929	101	65.80411	15
52.15756	18.57792	98	59.34564	15
51.14351	39.78230	380	82.69104	15
11.09985	27.43652	355	89.98915	15
22.48997	30.27819	430	81.81511	16
46.41745	19.75762	412	60.00325	16
42.68899	19.55907	296	61.64411	16
41.11405	31.33199	272	76.64890	16
69.07079	78.26982	242	55.34902	16
87.03588	21.33651	103	57.10889	17
24.75324	39.41073	220	91.83757	17
73.04070	26.74639	341	65.65745	17
84.07741	21.96245	87	58.15053	17
42.51679	34.39959	389	85.48948	17
20.69840	71.44970	280	99.92146	18
88.52868	23.05890	77	57.87046	18
20.13004	67.90056	321	100.00000	18
74.96835	22.05082	106	61.01210	18
12.49141	29.81086	102	91.11441	18
19.84825	29.66990	108	83.78651	19
12.67817	77.47627	231	100.00000	19
81.10267	23.74303	362	58.81251	19
25.08857	53.22702	17	98.62398	19
62.30769	33.14994	179	73.13870	19

A data.table: 6 × 43

density	%-similar-wanted	output	pred_output_1	RMSE_1	pred_output_2	RMSE_2	pred_output_3	RMSE_3	pred_output_4	...	pred_output_16	RMSE_16	pred_output_17	RMSE_17	pred_output_18	RMSE_18	pred_output_19	RMSE_19	pred_output_20	RMSE_20
<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	...	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>
89.39026	63.87711	98.25157	98.06408	0.1874907854	97.90124	0.35032646	97.55896	0.692611423	97.71552	...	97.91113	0.340435001	97.80597	0.445595741	97.74724	0.5043257154	97.97589	0.27567372	98.94148	0.68991317
39.27182	36.46039	86.97693	84.77677	2.2001527458	84.67340	2.30352367	84.80530	2.171627798	84.59319	...	86.61233	0.364594867	86.93959	0.037332690	86.58222	0.3947048053	86.49056	0.48636979	91.16148	4.18455238
30.17455	57.23629	98.35179	98.46249	0.1107008715	98.44887	0.09707907	98.45186	0.100065167	98.48240	...	98.44032	0.088526899	98.44399	0.092200436	98.35137	0.0004266621	98.36874	0.01694297	97.48138	0.87041492
28.12210	68.05564	99.86504	99.86457	0.0004754191	99.87540	0.01036148	99.87133	0.006284546	99.86404	...	99.86170	0.003340029	99.85942	0.005618104	99.84724	0.0177993828	99.84686	0.01818745	99.86023	0.00481316
80.09701	42.18455	82.70191	85.22754	2.5256286925	85.29744	2.59553111	85.34397	2.642056495	85.39381	...	85.33552	2.633607016	85.27330	2.571389489	85.33145	2.6295410083	85.16615	2.46423616	89.69242	6.99051355
67.68955	15.81212	54.62473	57.35935	2.7346178752	57.05422	2.42949282	56.76766	2.142925804	56.94051	...	55.36179	0.737058574	55.29447	0.669734579	55.31637	0.6916401851	55.34889	0.72416287	60.03025	5.40552035

A data.table: 20 × 2

iter	obb_error
<dbl>	<dbl>
1	13.206488
2	10.927211
3	9.601889
4	8.278378
5	8.291517
6	7.811656
7	7.498688
8	8.064948
9	7.260196
10	6.638461
11	7.325007
12	6.559538
13	6.846907
14	6.828797
15	6.249656
16	6.488448
17	6.525023
18	6.234868
19	6.514921
20	133.885355

iteration_history

A data.table: 20 × 3

iter_no	IsFeatureEliminated	IsDataSelected
<dbl>	<dbl>	<dbl>
1	0	1
2	0	1
3	0	1
4	0	1
5	0	1
6	0	1
7	0	1
8	0	1
9	0	1
10	0	1
11	0	1
12	0	1
13	0	1
14	0	1
15	0	1
16	0	1
17	0	1
18	0	1
19	1	1
20	0	0

performance_molten_AdFe <- melt(data = performance_table_AdFe
                             , id.vars = 'iter')
setnames(performance_molten_AdFe, c("variable","value"),c("errortype","errorvalue"))
p_AdFe = ggplot(performance_molten_AdFe, aes(x = iter, y = errorvalue, group=errortype, col=errortype)) + 
            geom_line(lwd=1) +
            geom_vline(xintercept = iteration_history[IsFeatureEliminated==1]$iter_no + 1, linetype = "dashed") +
            geom_vline(xintercept = iteration_history[IsDataSelected==1]$iter_no + 1, linetype = "dotdash",color = "yellow")
p_AdFe

Adaptive Sampling with/without Feature Elimination

grid.arrange(p_Ad, p_AdFe, ncol=2)

performance_Ad_vs_AdFe = rbind(performance_molten_Ad[,.(iter,errortype,errorvalue, type = "Ad")], performance_molten_AdFe[,.(iter,errortype,errorvalue, type = "AdFe")])
p_Ad_vs_AdFe = ggplot(performance_Ad_vs_AdFe, aes(x = iter, y = errorvalue, group=errortype, col=errortype)) + 
            geom_line(lwd=1) +
            geom_vline(xintercept = iteration_history[IsFeatureEliminated==1]$iter_no + 1, linetype = "dashed") +
            geom_hline(data = performance_molten_oneshot, aes(yintercept = errorvalue, group=errortype, col=errortype),stat = "hline", linetype = "dashed") +
            facet_wrap(~type)
p_Ad_vs_AdFe

ggplotly(p_Ad_vs_AdFe)

#varImpPlot(model_Ad)

Quit NL

NLQuit(nl.obj = nl.model)
#NLQuit(all=FALSE)